ETO Development Tools 1/ETO Development Tools 1.iso/Tools - Objects/MacApp/MacApp 2.0 CD Release/MacApp 2.0 (Many Libraries)/Libraries/UMacAppUtilities.inc1.p

Text File | 1990-03-27 | 71.3 KB | 2,823 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{UMacAppUtilities.inc1.p}
{Copyright © 1984-1990 Apple Computer, Inc.  All rights reserved.}

{ These are utilities.    Treat them like language extensions. }
{$W+}
{$R-}
{$Init-}
{$OV-}
{$IFC qNames}
{$D+}
{$ENDC}

{--------------------------------------------------------------------------------------------------}
                                                        { The debugger uses some of this unit's
                                                         types in it's interface so we must use
                                                         externals. !!! Resolve this. }

TYPE
    DebugForceOptions    = (forceOn, forceOff, forceUnchanged);

VAR
    {$Push} {$J+}
    gWorkPort:            GrafPtr;                        { Found in UMacApp.p }
    {$Pop}

FUNCTION DebugCanReadLn: Boolean;
    EXTERNAL;

FUNCTION DebugCanWriteLn: Boolean;
    EXTERNAL;

PROCEDURE DebugEndForce;
    EXTERNAL;

PROCEDURE ProgramBreak(grievance: Str255);
    EXTERNAL;

PROCEDURE DebugForceOutput(ToWindow, ToFile: DebugForceOptions);
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE BlockSet(destPtr: Ptr;
                   byteCount: longint;
                   setVal: UNIV SignedByte);

{ ??? should be improved to do longword setting. }

    VAR
        endPtr:             Ptr;

    BEGIN
    destPtr := Ptr(StripLong(destPtr));
    endPtr := Ptr(Ord(destPtr) + byteCount);
    WHILE Ord(destPtr) < Ord(endPtr) DO
        BEGIN
        destPtr^ := setVal;
        destPtr := Ptr(Ord(destPtr) + 1);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION CanWriteLn: Boolean;

    BEGIN
    {$IFC qDebug}
    CanWriteLn := DebugCanWriteLn;
    {$ELSEC}
    CanWriteLn := FALSE;
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION CanReadLn: Boolean;

    BEGIN
    {$IFC qDebug}
    CanReadLn := DebugCanReadLn;
    {$ELSEC}
    CanReadLn := FALSE;
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}                                             { Need to be able to alert user if this
                                                         isn't a 68020 machine }
{$S MAUtilitiesRes}                                     { This must always be in a resident segment
                                                         as aRect may be within a handle }

PROCEDURE CenterRectOnScreen(VAR aRect: Rect;
                             horizontally, vertically, forDialog: Boolean);

    VAR
        screenSize:         Point;
        rectSize:            Point;
        newSize:            INTEGER;

    BEGIN
    { Calculate screen size minus menu bar }
    WITH screenBits.bounds DO
        SetPt(screenSize, right - left, bottom - top - gMBarHeight);
                                                        { ??? should we use the same algorithm
                                                         as in TWindow.GetMaxIntersectedDevice }
    WITH aRect DO
        BEGIN
        SetPt(rectSize, right - left, bottom - top);
        IF horizontally THEN
            left := (screenSize.h - rectSize.h) DIV 2;
        IF vertically THEN
            IF forDialog THEN
                BEGIN
                newSize := (screenSize.v - rectSize.v) DIV 5;
                top := Max(newSize, 10) + gMBarHeight;
                END
            ELSE
                top := (screenSize.v - rectSize.v) DIV 2;

        right := left + rectSize.h;
        bottom := top + rectSize.v;
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION CloseFile(dataRefnum, rsrcRefnum: INTEGER): OSErr;

    VAR
        err:                OSErr;

    BEGIN
    err := noErr;

    IF dataRefnum <> kNoFileRefnum THEN
        err := FSClose(dataRefnum);

    IF rsrcRefnum <> kNoFileRefnum THEN
        BEGIN
        CloseResFile(rsrcRefnum);
        IF err = noErr THEN
            err := ResError;
        END;

    CloseFile := err;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION CompareStrings(first, second: Str255): INTEGER;

{$IFC NOT qNeedsROM128k}
    EXTERNAL;
{$ELSEC}

BEGIN
CompareStrings := RelString(first, second, TRUE, TRUE);
END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}
{$S MAUtilitiesRes}

FUNCTION ConcatNumber(aString: Str255;
                      aNumber: longint): Str255;

    VAR
        numberString:        Str255;

    BEGIN
    NumToString(aNumber, numberString);
    ConcatNumber := CONCAT(aString, numberString);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE ConfigRecFields(aTitle: Str255;
                          VAR aConfigRec: ConfigRecord;
                          PROCEDURE DoToField(fieldName: Str255;
                                              fieldAddr: Ptr;
                                              fieldType: INTEGER));

    CONST
        envSE30             = 7;                        { Not in the MPW 3.0 interfaces }

    VAR
        aString:            Str255;

    BEGIN
    DoToField(aTitle, NIL, bTitle);
    DoToField('  environsVersion', @aConfigRec.environsVersion, bInteger);

    CASE aConfigRec.machineType OF
        envMac:
            aString := 'envMac';
        envXL:
            aString := 'envXL';
        envMachUnknown:
            aString := 'envMachUnknown';
        env512KE:
            aString := 'env512KE';
        envMacPlus:
            aString := 'envMacPlus';
        envSE:
            aString := 'envSE';
        envMacII:
            aString := 'envMacII';
        envMacIIx:
            aString := 'envMacIIx';
        envSE30:
            aString := 'envSE30';
        OTHERWISE
            aString := 'envMachUnknown';
    END;
    DoToField('  machineType', @aString, bString);

    DoToField('  systemVersion', @aConfigRec.systemVersion, bHexInteger);

    CASE aConfigRec.processor OF
        envCPUUnknown:
            aString := 'envCPUUnknown';
        env68000:
            aString := 'env68000';
        env68010:
            aString := 'env68010';
        env68020:
            aString := 'env68020';
        env68030:
            aString := 'env68030';
        OTHERWISE
            aString := 'envCPUUnknown';
    END;
    DoToField('  processor', @aString, bString);

    DoToField('  hasFPU', @aConfigRec.hasFPU, bBoolean);
    DoToField('  hasColorQD', @aConfigRec.hasColorQD, bBoolean);

    CASE aConfigRec.keyboardType OF
        envUnknownKbd:
            aString := 'envUnknownKbd';
        envMacKbd:
            aString := 'envMacKbd';
        envMacAndPad:
            aString := 'envMacAndPad';
        envMacPlusKbd:
            aString := 'envMacPlusKbd';
        envAExtendKbd:
            aString := 'envAExtendKbd';
        envStandADBKbd:
            aString := 'envStandADBKbd';
        OTHERWISE
            aString := 'envUnknownKbd';
    END;
    DoToField('  keyboardType', @aString, bString);

    DoToField('  atDrvrVersNum', @aConfigRec.atDrvrVersNum, bInteger);
    DoToField('  sysVRefNum', @aConfigRec.sysVRefNum, bInteger);
    DoToField('  hasROM128K', @aConfigRec.hasROM128K, bBoolean);
    DoToField('  hasHFS', @aConfigRec.hasHFS, bBoolean);
    DoToField('  hasHierarchicalMenus', @aConfigRec.hasHierarchicalMenus, bBoolean);
    DoToField('  hasScriptManager', @aConfigRec.hasScriptManager, bBoolean);
    DoToField('  hasStyleTextEdit', @aConfigRec.hasStyleTextEdit, bBoolean);
    DoToField('  hasSoundManager', @aConfigRec.hasSoundManager, bBoolean);
    DoToField('  hasWaitNextEvent', @aConfigRec.hasWaitNextEvent, bBoolean);
    DoToField('  hasSCSI', @aConfigRec.hasSCSI, bBoolean);
    DoToField('  hasDesktopBus', @aConfigRec.hasDesktopBus, bBoolean);
    DoToField('  hasAUX', @aConfigRec.hasAUX, bBoolean);
    DoToField('  hasTempMem', @aConfigRec.hasTempMem, bBoolean);
    DoToField('  has32BitQD', @aConfigRec.has32BitQD, bBoolean);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE CopyStr255(VAR fmStr: Str255;
                     toAddr: UNIV Ptr);

    BEGIN
    BlockMove(@fmStr, toAddr, LENGTH(fmStr) + 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE DefaultSize(VAR theSize: INTEGER);

    BEGIN
    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        BEGIN
        IF theSize = GetDefFontSize THEN
            theSize := 0;
        END
    ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
        BEGIN
        IF (theSize = IntegerPtr(kLMSysFontSize)^) THEN
            theSize := 0;
        END
    ELSE IF theSize = 12 THEN                            { Guess }
        theSize := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION DeleteFile(namePtr: StringPtr;
                    volRefnum: INTEGER): OSErr;

    VAR
        hPB:                HParamBlockRec;
        err:                OSErr;

    BEGIN
    WITH hPB DO
        BEGIN
        ioNamePtr := namePtr;
        ioVRefnum := volRefnum;
        ioFVersNum := 0;
        END;

    err := FillInDirID(@hPB);                            {to avoid PMSP}

    IF err = noErr THEN
        err := PBHDelete(@hPB, FALSE);

    DeleteFile := err;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE DisposIfHandle(aHandle: UNIV Handle);

    BEGIN
    aHandle := DisposeIfHandle(aHandle);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION DisposeIfHandle(aHandle: UNIV Handle): Handle;

    CONST
        resourceBit         = 5;
        initVal             = $D3;                        { odd at all byte boundaries }

    VAR
        handleBits:         SignedByte;

    BEGIN
    DisposeIfHandle := NIL;                             { For convenience of caller }

    IF aHandle <> NIL THEN
        BEGIN
        IF qDebug THEN
            BEGIN
            { Test handlehood }
            IF IsHandle(aHandle) THEN
                BEGIN
                handleBits := GetHandleBits(aHandle);
                IF MemError <> noErr THEN
                    BEGIN
                    WriteLn('Handle was so bad I couldn''t even get the handle bits!');
                    WrLblHexLongint('Bad Handle', longint(aHandle));
                    WriteLn;
                    ProgramBreak('');
                    END
                ELSE IF IsHandlePurged(aHandle) THEN    { h might have been purged }
                    BEGIN
                    DisposHandle(aHandle);
                    END
                ELSE IF BTST(handleBits, resourceBit) THEN
                    BEGIN
                    WriteLn('Trying to dispose a resource handle');
                    WrLblHexLongint('Bad Handle', longint(aHandle));
                    WriteLn;
                    ProgramBreak('');
                    END
                ELSE
                    BEGIN
                    { Set the handle contents to a real nice value for any dangling pointerciples }
                    BlockSet(aHandle^, GetHandleSize(aHandle), initVal);
                    DisposHandle(aHandle);
                    END;
                END
            ELSE
                BEGIN
                IF VerboseIsHandle(aHandle) THEN;        { Get the diagnosis printed }
                WriteLn('Trying to dispose an invalid handle');
                WrLblHexLongint('Bad Handle', longint(aHandle));
                WriteLn;
                ProgramBreak('');
                END;
            END
        ELSE
            DisposHandle(aHandle);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE DisposIfPtr(aPtr: UNIV Ptr);

    BEGIN
    aPtr := DisposeIfPtr(aPtr);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION DisposeIfPtr(aPtr: UNIV Ptr): Ptr;

    CONST
        resourceBit         = 5;
        initVal             = $D5;                        { odd at all byte boundaries }

    BEGIN
    DisposeIfPtr := NIL;                                { For convenience of caller }

    IF aPtr <> NIL THEN
        BEGIN
        IF qDebug THEN
            BEGIN
            { Test pointerhood, ??? Shouldn't we have a real test here? }
            IF (NOT Odd(Ord(aPtr))) THEN
                BEGIN
                BlockSet(aPtr, GetPtrSize(aPtr), initVal);
                DisposPtr(aPtr);
                END
            ELSE
                BEGIN
                WriteLn('Trying to dispose an invalid pointer');
                WrLblHexLongint('Bad Pointer', longint(aPtr));
                WriteLn;
                ProgramBreak('');
                END;
            END
        ELSE
            DisposPtr(aPtr);
        aPtr := NIL;
        END;
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION EqualBlocks(first, second: UNIV Ptr;
                     theSize: INTEGER): Boolean;
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE EachWMgrWindowDo(PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr));

    VAR
        aWindowPtr:         WindowPtr;

    BEGIN
    aWindowPtr := GetWindowList;
    WHILE (aWindowPtr <> NIL) DO
        BEGIN
        DoToWMgrWindow(aWindowPtr);
        aWindowPtr := WindowPtr(WindowPeek(aWindowPtr)^.nextWindow);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION FindWindowBefore(theWindow: WindowPtr): WindowPtr;
{ returns the window just before a given window.  Returns nil if the given window is frontmost or
  not found. }

    PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr);

        BEGIN
        IF WindowPtr(WindowPeek(theWMgrWindow)^.nextWindow) = theWindow THEN
            BEGIN
            FindWindowBefore := theWMgrWindow;
            exit(FindWindowBefore);
            END;
        END;

    BEGIN
    FindWindowBefore := NIL;
    EachWMgrWindowDo(DoToWMgrWindow);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION FileModDate(name: Str255;
                     volRefnum: INTEGER): longint;

    VAR
        pb:                 HParamBlockRec;

    BEGIN
    IF GetFileInfo(name, volRefnum, pb) = noErr THEN
        FileModDate := pb.ioFlMdDat
    ELSE
        FileModDate := 0;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE FieldToString(theData: Ptr;
                        fieldType: INTEGER;
                        VAR theString: Str255);
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION FillInDirID(pb: HParmBlkPtr): OSErr;

    BEGIN
    FillInDirID := GetDirID(pb^.ioVRefnum, pb^.ioDirID);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION GetActualJustification(justification: INTEGER): INTEGER;

    BEGIN
    IF justification = teJustSystem THEN                { actually teJustLeft }
        BEGIN
        IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
            GetActualJustification := GetSysJust
        ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
            GetActualJustification := IntegerPtr(kLMTESysJust)^
        ELSE
            GetActualJustification := teJustLeft;
        END
    ELSE
        GetActualJustification := justification;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION GetDirID(VAR vRefnum: INTEGER;
                  VAR dirID: longint): OSErr;

    VAR
        pb:                 WDPBRec;

    BEGIN
    IF qNeedsROM128K | gConfiguration.hasHFS THEN
        BEGIN
        WITH pb DO
            BEGIN
            ioNamePtr := NIL;
            ioVRefnum := vRefnum;
            ioWDIndex := 0;
            ioWDProcID := 0;
            ioWDVRefnum := vRefnum;
            END;
        GetDirID := PBGetWDInfo(@pb, FALSE);
        vRefnum := pb.ioWDVRefnum;
        dirID := pb.ioWDDirID;
        END
    ELSE
        BEGIN
        dirID := 0;
        GetDirID := noErr;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION GetFileInfo(name: Str255;
                     volRefnum: INTEGER;
                     VAR info: HParamBlockRec): OSErr;

    VAR
        err:                OSErr;

    BEGIN
    WITH info DO
        BEGIN
        ioNamePtr := @name;
        ioVRefnum := volRefnum;
        ioFVersNum := 0;
        ioFDirIndex := 0;
        END;
    err := FillInDirID(@info);
    IF err = noErr THEN
        err := PBHGetFInfo(@info, FALSE);
    GetFileInfo := err;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION GetFontNum(fontName: Str255): INTEGER;

    VAR
        fontNum:            INTEGER;

    BEGIN
    UprString(fontName, FALSE);
    IF fontName = kSysFontName THEN
        BEGIN
        IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
            fontNum := GetSysFont
        ELSE
            fontNum := systemFont;
        END
    ELSE IF fontName = kApplFontName THEN
        BEGIN
        IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
            fontNum := GetAppFont
        ELSE
            fontNum := applFont;
        END
    ELSE
        GetFNum(fontName, fontNum);
    GetFontNum := fontNum;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     {Must be in Main segment and cannot call to
                                                         any other segment.}

FUNCTION GetHandleBits(h: Handle): SignedByte;

    BEGIN
    IF qNeedsROM128K | gConfiguration.hasROM128K THEN
        GetHandleBits := HGetState(h)
    ELSE
        GetHandleBits := SignedBytePtr(h)^;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC NOT qNeedsColorQD}                                { Becomes an inline if we know the machine
                                                         has color QD }
{$S MAUtilitiesRes}

PROCEDURE GetIfBkColor(VAR aColor: RGBColor);

    CONST
        BlackBit            = 5;
        YellowBit            = 6;
        MagentaBit            = 7;
        CyanBit             = 8;

    VAR
        oldColor:            longint;

    BEGIN
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        GetBackColor(aColor)
    ELSE
        BEGIN                                            { Map old, dumb CMYB system to RGB color }
        {[f-]}
        (*                        xxxxxxx C.MY B rgb w b    = RGB
        blackColor        =  33 = 0000000 0.00 1 000 0 1    = 000
        whiteColor        =  30 = 0000000 0.00 0 111 1 0    = 111
        redColor        = 205 = 0000000 0.11 0 011 0 1    = 100
        greenColor        = 341 = 0000000 1.01 0 101 0 1    = 010
        blueColor        = 409 = 0000000 1.10 0 110 0 1    = 001
        cyanColor        = 273 = 0000000 1.00 0 100 0 1    = 011
        magentaColor    = 137 = 0000000 0.10 0 010 0 1    = 101
        yellowColor     =  69 = 0000000 0.01 0 001 0 1    = 110
        *)
        {[f+]}

        oldColor := thePort^.bkColor;                    { Fetch old color }
        aColor := gRGBBlack;                            { Prime returned color to black }
        IF BTST(oldColor, BlackBit) THEN                { If color isn't black, force CMY = 111 }
            oldColor := BOR(oldColor, $1C0);
        IF NOT BTST(oldColor, CyanBit) THEN             { Absence of cyan = presence of red }
            aColor.red := $FFFF;
        IF NOT BTST(oldColor, MagentaBit) THEN            { Absence of magenta = presence of green }
            aColor.green := $FFFF;
        IF NOT BTST(oldColor, YellowBit) THEN            { Absence of yellow = presence of blue }
            aColor.blue := $FFFF;
        END;
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$IFC NOT qNeedsColorQD}                                { Becomes an inline if we know the machine
                                                         has color QD }
{$S MAUtilitiesRes}

PROCEDURE GetIfColor(VAR aColor: RGBColor);

    CONST
        BlackBit            = 5;
        YellowBit            = 6;
        MagentaBit            = 7;
        CyanBit             = 8;

    VAR
        oldColor:            longint;

    BEGIN
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        GetForeColor(aColor)
    ELSE
        BEGIN                                            { Map old, dumb CMYB system to RGB color }
  {   xxxxxxx C.MY B rgb w b = RGB
  blackColor  =  33 = 0000000 0.00 1 000 0 1 = 000
  whiteColor  =  30 = 0000000 0.00 0 111 1 0 = 111
  redColor = 205 = 0000000 0.11 0 011 0 1 = 100
  greenColor  = 341 = 0000000 1.01 0 101 0 1 = 010
  blueColor  = 409 = 0000000 1.10 0 110 0 1 = 001
  cyanColor  = 273 = 0000000 1.00 0 100 0 1 = 011
  magentaColor = 137 = 0000000 0.10 0 010 0 1 = 101
  yellowColor  =  69 = 0000000 0.01 0 001 0 1 = 110
  }
        oldColor := thePort^.fgColor;                    { Fetch old color }
        aColor := gRGBBlack;                            { Prime returned color to black }
        IF BTST(oldColor, BlackBit) THEN                { If color isn't black, force CMY = 111 }
            oldColor := BOR(oldColor, $1C0);
        IF NOT BTST(oldColor, CyanBit) THEN             { Absence of cyan = presence of red }
            aColor.red := $FFFF;
        IF NOT BTST(oldColor, MagentaBit) THEN            { Absence of magenta = presence of green }
            aColor.green := $FFFF;
        IF NOT BTST(oldColor, YellowBit) THEN            { Absence of yellow = presence of blue }
            aColor.blue := $FFFF;
        END;
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE GetPortFontInfo(fontNum: INTEGER;
                          VAR fontName: Str255;
                          VAR fontSize: INTEGER);

    BEGIN
    IF (fontNum = systemFont) | ((qNeedsROM128K | gConfiguration.hasROM128K) & (
       (qNeedsScriptManager | gConfiguration.hasScriptManager) & (fontNum = GetSysFont)) |
       (fontNum = IntegerPtr(kLMSysFontFam)^)) THEN
        BEGIN
        fontName := kSysFontName;
        DefaultSize(fontSize);
        END

    ELSE IF (fontNum = applFont) | (((qNeedsScriptManager | gConfiguration.hasScriptManager) &
            (fontNum = GetAppFont)) | (fontNum = IntegerPtr(kLMApFontID)^)) THEN
        BEGIN
        fontName := kApplFontName;
        DefaultSize(fontSize);
        END

    ELSE
        GetFontName(fontNum, fontName);
    END;

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}
{$S Main}

PROCEDURE LockHandleHigh(h: Handle);

    BEGIN
    IF h <> NIL THEN
        BEGIN
        IF qDebug & NOT IsHandle(h) THEN
            BEGIN
            IF VerboseIsHandle(h) THEN;                 { Get the diagnosis printed }
            ProgramBreak('In LockHandleHigh: not handed a handle');
            END
        ELSE
            BEGIN
            MoveHHi(h);                                 { ??? check MemErr ??? }
            HLock(h);
            END;
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}
{$S MAUtilitiesRes}

FUNCTION GetTrapType(theTrap: INTEGER): TrapType;

    BEGIN
    { OS traps start with A0, Tool with A8 or AA. }
    IF BAND(theTrap, $0800) = 0 THEN                    { per D.A }
        GetTrapType := OSTrap
    ELSE
        GetTrapType := ToolTrap;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{ Nothing in this procedure can be allowed to fail }
{$Push}
{$MC68020-}
{$S MAMiniInit}

PROCEDURE DoRealInitToolBox;

    VAR
        aCursHandle:        CursHandle;

    BEGIN
    InitGraf(@thePort);
    InitFonts;
    InitWindows;                                        { creates non-relocatable for the WM port }

    { _DON'T_ flush disk-inserted or MultiFinder™ events or you'll be sorry! }
    FlushEvents(everyEvent - diskMask - app4Evt, 0);

    InitMenus;
    TEInit;
    InitDialogs(NIL);
    aCursHandle := GetCursor(watchCursor);                { Watch should be in system file, but just
                                                         in case… }

    InitCursor;                                         { !!! This forces an arrow cursor. Is there
                                                         a way to reset the show/hide level and
                                                         init all the cursor goo without having
                                                         this visual glitch? ( the Finder™ sets the
                                                         cursor to a watch when launching. It would
                                                         be nice to stay that way until the app is
                                                         ready for events. }
    IF aCursHandle <> NIL THEN
        SetCursor(aCursHandle^^);                        { Change cursor to watch }

    {$IFC qDebug}                                        { Enable pre and postcondition testing }
    gPreCondition := TRUE;
    gPostCondition := TRUE;
    {$ENDC}

    { Find out just what kind of environment we're dealing with here }
    DefineConfiguration(gConfiguration);

    { Init the stuff that MATextBox uses }
    gMATextBoxTE := NIL;
    gTEDefaultWordBreak := NIL;

    SetRGBColor(gRGBBlack, 0, 0, 0);
    SetRGBColor(gRGBWhite, $FFFF, $FFFF, $FFFF);

    { -1 = $FFFFFFFF, the largest 32 bit address.  Our routine StripLong uses a pre-stripped
    address gStrippedAddress to avoid the yucky MPW glue. }
    gStrippedAddress := StripAddress(Ptr( - 1));

    { !!! I hate to have to allocate this memory here.    Is there a better way to encapsulate
    this and defer the allocation until later.    Many routines touch the region (Even after
    InvalidateCursor was implemented) }
    gCursorRgn := NewRgn;                                { Hope it doesn't fail. Really isn't likely
                                                         to though. }

    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        gMBarHeight := GetMBarHeight
    ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
        gMBarHeight := GetLMMBarHeight
    ELSE
        gMBarHeight := 20;                                { Guess }

    {$IFC qDebug OR qInspector}
    gFieldToStrRtn := @StdFieldToString;
    {$EndC}

    gBoolString[TRUE] := 'TRUE';
    gBoolString[FALSE] := 'FALSE';
    gDeadStripSuppression := FALSE;
    gCreateWithTemplates := gDeadStripSuppression;        { for compatibility with Dave W. class notes
                                                         }
    { The refnum where the application's resources should be found }
    gApplicationRefNum := CurResFile;

    gToolBoxInitialized := TRUE;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{ Nothing in this procedure can be allowed to fail }
{$Push}
{$MC68020-}
{$S Main}                                                { This procedure is intended to be in "Main"
                                                         which is already loaded }

PROCEDURE _DataInit;                                    { Routine in the A5 globals initializer }
    EXTERNAL;

PROCEDURE InitToolBox;

    CONST
        kBreathingRoom        = 1024;                     { Amount of heap space needed for init }

    VAR
        totalSize:            Size;
        contigSize:         Size;
        h:                    Handle;

    PROCEDURE FailedInitToolBox;

        BEGIN
        IF qDebug THEN
            DebugStr('Not enough room to init ToolBox Managers');
        ExitToShell;                                    {??? any good way to signal this to the user
                                                         ???}
        END;

    BEGIN
    { the heap and stack don't overlap. So there's enough room to init the managers.
    Make sure that the MAMiniInit Segment can be loaded and that there's still a little
    Room after that. }

    UnloadSeg(@_DataInit);                                { Toss some ballast }

    { "MAMain" this is MacApp's own code that must be resident… even before/during the UMemory startup.
    GetNamedResource will call RsrvMem which locates the handle as low in memory as possible.
    We will then lock it there… just like "Main"}
    SetResLoad(FALSE);
    h := GetNamedResource('CODE', 'MAMain');
    SetResLoad(TRUE);
    IF (h <> NIL) THEN
        ResrvMem(SizeResource(h));
    h := GetNamedResource('CODE', 'MAMain');
    IF (h <> NIL) THEN
        HLock(h)
    ELSE
        FailedInitToolBox;

    h := GetNamedResource('CODE', 'MAMiniInit');
    IF (h <> NIL) THEN
        HLock(h)
    ELSE
        FailedInitToolBox;

    { Attempt to ensure that there is going to be kBreathingRoom bytes available in the heap so that
    when the actual toolbox managers are initialized there is a significantly reduced chance that
    they will express their displeasure with us through SysErr -25 or -2.  If the space is not
    currently available in the zone as shown by PurgeSpace then attempting to allocate it will let
    growzoneproc operate and grow the zone a little, as necessary.  If, after that, we haven't been
    able to get the breathing room we desire then just give up and fade silently away. (Like the old
    soldier, not the old executive). }

    PurgeSpace(totalSize, contigSize);

    IF totalSize >= kBreathingRoom THEN
        DoRealInitToolBox
    ELSE
        BEGIN
        h := NewHandle(kBreathingRoom);
        IF h <> NIL THEN                             { get the grow space }
            BEGIN
            DisposHandle(h);
            DoRealInitToolBox;
            END
        ELSE
            FailedInitToolBox;                        { Give up }
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{ Nothing in this procedure can be allowed to fail }
{$Push}
{$MC68020-}
{$S MAMiniInit}

FUNCTION ValidateConfiguration(configuration: ConfigRecord): Boolean;

    VAR
        isSupported:        Boolean;

    BEGIN
    { Run the gauntlet of support tests using the conditionally set constants.
    If any single test fails then the app is considered unsupported on this machine.  }

    isSupported := TRUE;

    IF qNeedsScriptManager THEN
        isSupported := isSupported & configuration.hasScriptManager;

    IF qNeedsROM128K THEN
        isSupported := isSupported & configuration.hasROM128K;

    IF qNeedsHierarchicalMenus THEN
        isSupported := isSupported & configuration.hasHierarchicalMenus;

    IF qNeedsStyleTextEdit THEN
        isSupported := isSupported & configuration.hasStyleTextEdit;

    IF qNeedsWaitNextEvent THEN
        isSupported := isSupported & configuration.hasWaitNextEvent;

    IF qNeedsColorQD THEN
        isSupported := isSupported & configuration.hasColorQD;

    IF qNeedsMC68020 THEN
        isSupported := isSupported & ((configuration.processor <> env68000) &
                       (configuration.processor <> env68010));

    IF qNeedsMC68030 THEN
        isSupported := isSupported & ((configuration.processor <> env68000) &
                       (configuration.processor <> env68010) & (configuration.processor <>
                       env68020));

    IF qNeedsFPU THEN
        isSupported := isSupported & configuration.hasFPU;

    ValidateConfiguration := isSupported;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{ Nothing in this procedure can be allowed to fail }
{$Push}
{$MC68020-}
{$S MAMiniInit}

PROCEDURE DefineConfiguration(VAR configuration: ConfigRecord);

    CONST

        {Masks for the HwCfgFlags}
        mSCSIPort            = $8000;
        mDesktopBus         = $0400;
        mHasAUX             = $0200;

        { Test that DTS says is OK for 32 bit QD.  It is an internal trap that is only implemented
        if QD32 is installed.    }
        _MA32BitQD            = $AB03;

    VAR
        kludge:             ^SysEnvRec;
        result:             OSErr;

    BEGIN
    kludge := @configuration;
    result := SysEnvirons(1, kludge^);                    {Version 1 shouldn't fail}

    WITH configuration DO
        BEGIN
        hasDesktopBus := BAND(GetHwCfgFlags, mDesktopBus) > 0;
        hasSCSI := BAND(GetHwCfgFlags, mSCSIPort) > 0;
        hasAUX := BAND(GetHwCfgFlags, mHasAUX) > 0;
        hasROM128K := machineType > envMac;
        IF hasROM128K THEN
            hasHFS := TRUE
        ELSE
            hasHFS := GetFSFCBLen > 0;
        hasHierarchicalMenus := hasROM128K & TrapExists(_PopUpMenuSelect);
        hasScriptManager := hasROM128K & TrapExists(_ScriptUtil);
        hasStyleTextEdit := systemVersion >= $600;
        hasSoundManager := hasROM128K & TrapExists(_SndDoCommand);
        hasWaitNextEvent := hasROM128K & TrapExists(_WaitNextEvent);
        hasTempMem := TrapExists(_OSDispatch);
        has32BitQD := TrapExists(_MA32BitQD);
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{ Nothing in this procedure can be allowed to fail }
{$Push}
{$MC68020-}
{$S Main}                                                { Must be in main segment as it is called in
                                                         early initialization AND in MacAppAlert }

PROCEDURE PullApplicationToFront;

    VAR
        theEvent:            EventRecord;
        i:                    INTEGER;

    BEGIN
    { The "Programmer's guide to MultiFinder™ says make an event call several times.
    I guess 3 calls counts as several.    Also, it says call GetNextEvent but we don't
    want to lose events on the floor so we use EventAvail since it seems to work OK }
    FOR i := 1 TO 3 DO
        IF EventAvail(everyEvent, theEvent) THEN;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}

{$S MAUtilitiesRes}

FUNCTION IsFreeHandle(h: UNIV Handle): Boolean;
{ Walk the free-list looking for the given handle }

    VAR
        applZone:            THz;
        currHandle:         Handle;

    BEGIN
    IsFreeHandle := FALSE;
    applZone := ApplicZone;
    currHandle := Handle(applZone^.hFstFree);
    WHILE (currHandle <> NIL) DO
        BEGIN
        IF currHandle = h THEN
            BEGIN
            IsFreeHandle := TRUE;
            LEAVE;
            END;
        currHandle := Handle(currHandle^);
        END;

    END;

{--------------------------------------------------------------------------------------------------}

{$S MAUtilitiesRes}

FUNCTION TestRecoverHandle(masterPointer: Ptr;
                           h: UNIV Handle): Boolean;

{ TestRecoverHandle determines if the given masterPointer recovers via RecoverHandle to be the given
handle h. Since RecoverHandle fails if h is from a heap other than the current heap, we need to set
the zone to be the handle's zone before calling RecoverHandle. }

    VAR
        itsZone,                                        { the handle's zone }
        currentZone:        THz;                        { the current zone (don't assume ApplicZone)
                                                         }
        restoreZone:        Boolean;                    { flag whether to restore zone }

    BEGIN
    TestRecoverHandle := FALSE;

    { Test handle's Zone - if it comes from a different zone, then RecoverHandle won't work,
    in that case, set the current zone to be the handle's zone }

    itsZone := HandleZone(h);                            { get the handle's zone }
    IF MemError = noErr THEN
        BEGIN
        currentZone := GetZone;                         { get the current zone }
        IF itsZone = currentZone THEN                    { Are zones the same? }
            restoreZone := FALSE                        { …yes, so set flag to not restore }
        ELSE
            BEGIN
            restoreZone := TRUE;                        { …no, so set flag to restore zone }
            SetZone(itsZone);                            { and set the zone to be the handle's zone }
            END;

        TestRecoverHandle := RecoverHandle(masterPointer) = Handle(h);

        IF restoreZone THEN                             { restore the zone if the flag is set }
            SetZone(currentZone);
        END;
    END;

{--------------------------------------------------------------------------------------------------}

{$S MAUtilitiesRes}

FUNCTION IsHandle(h: UNIV Handle): Boolean;
{ Returns true if handle appears valid. }

    VAR
        masterPointer:        Ptr;

    BEGIN
    IsHandle := FALSE;

    IF
    { Test handle NILness }
      (h <> NIL)
    { Test handle Oddness }
      & NOT Odd(Ord(h)) THEN
        BEGIN
        masterPointer := Ptr(StripLong(h^));
        IsHandle :=
        { Test master pointer Oddness }
          (NOT Odd(Ord(masterPointer)))
        { Not Purged… does it recover? }
          & (((masterPointer <> NIL) & (TestRecoverHandle(masterPointer, h)))
        { Purged }
          | (masterPointer = NIL));
        END;
    END;

{--------------------------------------------------------------------------------------------------}

{$S MAUtilitiesRes}

FUNCTION IsHandleLocked(h: UNIV Handle): Boolean;
{ Returns lockState of h. }

    CONST
        lockBit             = 7;

    VAR
        handleBits:         SignedByte;

    BEGIN
    handleBits := GetHandleBits(h);
    IF MemError <> noErr THEN                            { h might have been purged }
        IsHandleLocked := FALSE
    ELSE
        IsHandleLocked := BTST(handleBits, lockBit);
    END;

{--------------------------------------------------------------------------------------------------}

{$IFC qDebug}
{$S MAUtilitiesRes}

FUNCTION IsHandlePurged(h: UNIV Handle): Boolean;
{ Returns purgeState of h. }

    BEGIN
    IF qDebug & NOT IsHandle(h) THEN
        BEGIN
        IF VerboseIsHandle(h) THEN;                     { Get the diagnosis printed }
        ProgramBreak('IsHandlePurged was not handed a handle, pretty handy, eh?');
        IsHandlePurged := TRUE;                         { !!! What is a decent result. shouldn't
                                                         developer just signal failure from the
                                                         debugger. We need to force the issue }
        END
    ELSE
        IsHandlePurged := h^ = NIL;
    END;
{$EndC}

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION LengthRect(r: Rect;
                    vhs: VHSelect): INTEGER;

    BEGIN
    WITH r DO
        LengthRect := botRight.vh[vhs] - topLeft.vh[vhs];
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION LongerSide(VAR r: Rect): VHSelect;

    BEGIN
    WITH r DO
        IF (bottom - top) >= (left - right) THEN
            LongerSide := v
        ELSE
            LongerSide := h;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

PROCEDURE LIntToHex(decNumber: UNIV longint;
                    VAR hexNumber: String8;
                    noOfDigits: INTEGER);

    VAR
        i:                    INTEGER;

    BEGIN
    noOfDigits := Min(noOfDigits, 8);
    hexNumber[0] := CHR(noOfDigits);
    FOR i := noOfDigits DOWNTO 1 DO
        BEGIN
        hexNumber[i] := kHexDigits[BAND(decNumber, 15) + 1];
        decNumber := BSR(decNumber, 4);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION LowerChar(ch: CHAR): CHAR;

    BEGIN
    IF (ch >= 'A') & (ch <= 'Z') THEN
        LowerChar := CHR(Ord(ch) + 32)
    ELSE
        LowerChar := ch;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE LowerStr255(VAR s: Str255);

    VAR
        i:                    INTEGER;

    BEGIN
    FOR i := 1 TO LENGTH(s) DO
        IF (s[i] IN ['A'..'Z']) THEN
            s[i] := CHR(Ord(s[i]) + 32)
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION MAUseResFile(refNum: INTEGER): INTEGER;
{ UseResFile the newResFile and return the old CurResFile. }

    BEGIN
    MAUseResFile := CurResFile;
    UseResFile(refNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION MinMax(MinVal, expression, MaxVal: longint): longint;
{Returns the bounded minimum and maximum }

    BEGIN
    MinMax := Min(Max(expression, MinVal), MaxVal);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

PROCEDURE NumberToHex(theNumber: UNIV longint;
                      VAR hexString: Str255;
                      hexDigits: INTEGER);

    VAR
        tempString:         String8;

    BEGIN
    LIntToHex(theNumber, tempString, hexDigits);
    hexString := CONCAT('$', tempString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

PROCEDURE PointerToHex(theNumber: UNIV longint;
                       VAR hexString: Str255;
                       hexDigits: INTEGER);

    VAR
        tempString:         String8;

    BEGIN
    IF theNumber = 0 THEN
        hexString := 'Nil'
    ELSE
        BEGIN
        LIntToHex(StripLong(theNumber), tempString, hexDigits);
        hexString := CONCAT('$', tempString);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION NumBlocks(numBytes: longint;
                   blkSize: longint): longint;

    BEGIN
    NumBlocks := (numBytes + blkSize - 1) DIV blkSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFile}

FUNCTION MAOpenFile(name: Str255;
                    volRefnum: INTEGER;
                    openData, openRsrc: Boolean;
                    dataPerm, rsrcPerm: INTEGER;
                    VAR dataRefnum, rsrcRefnum: INTEGER): OSErr;

    VAR
        pb:                 HParamBlockRec;
        oldVRefnum:         INTEGER;
        result:             OSErr;

    PROCEDURE TestForError(err: OSErr);

        BEGIN
        IF err <> noErr THEN
            BEGIN
            MAOpenFile := err;
            exit(MAOpenFile);
            END;
        END;

    BEGIN
    {always open data fork, to establish that the file does exist}
    WITH pb DO
        BEGIN
        ioNamePtr := @name;
        ioVRefnum := volRefnum;
        ioVersNum := 0;
        ioPermssn := dataPerm;
        ioMisc := NIL;
        END;
    TestForError(FillInDirID(@pb));

    IF qNeedsROM128K | gConfiguration.hasHFS THEN
        result := PBHOpenDeny(@pb, FALSE)                { Try the shared volume open. }
    ELSE
        result := paramErr;

    IF result = paramErr THEN                            { Not on a shared volume, try HFS open. }
        BEGIN
        pb.ioPermssn := BAND(dataPerm, 3);
        result := PBHOpen(@pb, FALSE);
        END;
    TestForError(result);

    IF openData THEN
        dataRefnum := pb.ioRefnum
    ELSE
        BEGIN
        { we did not want the data fork open, so close it now }
        TestForError(FSClose(pb.ioRefnum));
        dataRefnum := kNoFileRefnum;
        END;

    IF openRsrc THEN
        BEGIN
        IF qNeedsROM128K | gConfiguration.hasROM128K THEN
            BEGIN
            rsrcRefnum := OpenRFPerm(name, volRefnum, BAND(rsrcPerm, 7));
            result := ResError;
            END
        ELSE
            BEGIN
            TestForError(GetVol(NIL, oldVRefnum));
            TestForError(SetVol(NIL, volRefnum));

            rsrcRefnum := OpenResFile(name);

            TestForError(SetVol(NIL, oldVRefnum));
            END;

        IF result <> noErr THEN
            rsrcRefnum := kNoFileRefnum;

        TestForError(result);
        END
    ELSE
        rsrcRefnum := kNoFileRefnum;

    MAOpenFile := noErr;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

VAR
    pSaveHText:         Handle;
    pMATextBoxHText:    Handle;

{$Push}
{$IFC qTrace} {$D+} {$ENDC}

PROCEDURE StdNoRect(verb: GrafVerb;
                    r: Rect);
{ StdNoRect filters out the rect drawing calls. }

    BEGIN
    END;
{$Pop}

PROCEDURE MATextBox(text: Ptr;
                    itsLength: longint;
                    box: Rect;
                    itsJust: INTEGER;
                    autoWrap: Boolean;
                    wordBreak: ProcPtr;
                    eraseFirst: Boolean;
                    spaceForCaret: Boolean);

    CONST
        kTextBoxCaretSlopSize = 1;                        { Since TextBox uses TE to image the text,
                                                         we may need to adjust by 1 pixel. Reason:
                                                         TE draws beginning 1 pixel to the right to
                                                         allow for the insertion point (which we
                                                         won't have since this is drawn text, not
                                                         editable text).}
        kMaxTEChars         = 32000;                    { Actually TE suffers some other limitations
                                                         as well. Such as misbehaviour and or
                                                         bombing when the sum of the lineheights >
                                                         32k or a linewidth > 32k (overflows
                                                         QuickDraw space) But these are _MUCH_ more
                                                         difficult to test for in a quick way }
        kOurMaxHandleSize        = 256;                    { our Max handle size }

    VAR
        fInfo:                FontInfo;
        savedHText:         Handle;
        sysJust:            INTEGER;
        { these next two locals eat up lots of stack space...this could be improved by allocating
        a pointer for the one that is used (eg allocate a pointer for myCQDProcs if CDQ available) }
        myQDProcs:            QDProcs;
        myCQDProcs:         CQDProcs;
        hadQDProcs:            BOOLEAN;
        saveRectProc:        ProcPtr;

    PROCEDURE InitMyPrivateTE;

        CONST
            kZoneHeader         = 52;                    { 52 bytes for header }
            kZoneTrailer        = 12;                    { 12 bytes for trailer }
            kMPBlockHeader        = 8;                    { 8 bytes for Master Pointer block hdr }
            kInitialMstrPtrs    = 2;                    { 2 master pointers created initially }
            kSlop                = 32;                    { bytes of slop (just in case) }
            kZoneOverhead        = kZoneHeader + kZoneTrailer + kMPBlockHeader +
                                  4 * kInitialMstrPtrs + kSlop; { how large the zone overhead is }

        VAR
            aTEZonePtr:         Ptr;
            startPtr:            Ptr;

        BEGIN
        pMATextBoxHText := NIL;

        gMATextBoxTE := TENew(box, box);
        IF (gMATextBoxTE = NIL) THEN                    { can't allocate space for our terecord }
            exit(InitMyPrivateTE);

        { • save off several items of interest }
        WITH gMATextBoxTE^^ DO
            BEGIN
            gTEDefaultWordBreak := wordBreak;
            pSaveHText := hText;                        { save the text handle }
            END;

        { • Since TESetText (called near the end of MATextBox) hits the heap, we can speed this hit
        to the heap for small text lengths (<= 255), by allocating a special text handle in its own
        separate heap. We'll use this text handle whenever the text length is <= 255. }

        { • create a separate heap }
        aTEZonePtr := NewPtr(kOurMaxHandleSize + kZoneOverhead);
        IF (aTEZonePtr = NIL) THEN                        { can't allocate space for our heap }
            exit(InitMyPrivateTE);
        startPtr := Ptr(StripLong(aTEZonePtr));
        InitZone(NIL, kInitialMstrPtrs, Ptr(Ord(startPtr) + GetPtrSize(aTEZonePtr)), startPtr);

        { • InitZone sets the current zone to the newly created zone }

        { • allocate our new text handle in our new heap zone }
        pMATextBoxHText := NewHandle(kOurMaxHandleSize);     { the text handle }

        { • restore the heap zone  }
        SetZone(ApplicZone);
        END;

    FUNCTION IsColorPort(aGrafPtr: GrafPtr): BOOLEAN;

        BEGIN
        IsColorPort :=  (qNeedsColorQD | gConfiguration.hasColorQD)
        & (BAND(CGrafPtr(aGrafPtr)^.portVersion, $C000) = $0000C000)  { 2 hi bits. IM V pp. 49-50 }
        END;


    BEGIN
    { Create my goodies if necessary }
    IF gMATextBoxTE = NIL THEN
        BEGIN
        InitMyPrivateTE;

        IF gMATextBoxTE = NIL THEN                        { couldn't allocate the TE handle }
            BEGIN
            TextBox(text, itsLength, box, itsJust);     { default to TextBox in low memory }
            exit(MATextBox);
            END;
        END;

    { Setup the work TE with the necessary parameters }
    GetFontInfo(fInfo);                                 { Need to get font's height and ascent. }

    { Horse the intersection of the clip and the box into the TE's viewRect
    and then only draw at all if that rect is non empty }
    IF SectRect(thePort^.clipRgn^^.rgnBBox, box, gMATextBoxTE^^.viewRect) THEN
        BEGIN
        WITH gMATextBoxTE^^, fInfo DO
            BEGIN
            destRect := box;
            IF NOT spaceForCaret THEN                        { widen the destrect but not the visrect.
                                                             This lets the 1 pixel wide area to the
                                                             left of all text and the right of all text
                                                             go unshown. }
                BEGIN
                WITH destRect DO
                    BEGIN
                    left := left - kTextBoxCaretSlopSize;
                    right := right + kTextBoxCaretSlopSize;
                    END;
                END;


            { Enforce minimum width on destRect ala IM-I pp. 383.  Although the text says that
            20 is a good number, using the widMax ensures that it is correct for all font sizes. }
            WITH destRect DO
                right := left + Max(Max(right - left, widMax), 20);

            inPort := thePort;                                { Current port and its characteristics }

            txSize := thePort^.txSize;
            txFont := thePort^.txFont;
            txFace := thePort^.txFace;
            fontAscent := ascent;
            lineHeight := ascent + descent + leading;

            TESetJust(itsJust, gMATextBoxTE);                { be good, use the trap }

            IF autoWrap THEN
                crOnly := 0                                 {if >=0, word wrap}
            ELSE
                crOnly := - 1;                                {if <0, new line at Return only}

            wordBreak := gTEDefaultWordBreak;
            END;

        IF wordBreak <> NIL THEN
            SetWordBreak(wordBreak, gMATextBoxTE);            { set the word break routine }

        IF (pMATextBoxHText <> NIL) THEN                    { if our private heap is set up }
            BEGIN
            IF itsLength <= kOurMaxHandleSize  THEN        { short strings go in the mini-heap }
                gMATextBoxTE^^.hText := pMATextBoxHText
            ELSE
                gMATextBoxTE^^.hText := pSaveHText;
            END;

        TESetText(text, Min(itsLength, kMaxTEChars), gMATextBoxTE);

        { if called with eraseFirst TRUE, then let TEUpdate image with its built-in EraseRect }
        IF eraseFirst THEN
            BEGIN
            EraseRect(gMATextBoxTE^^.viewRect); { Oh yeah?  Some versions of TE _DON'T_ erase first! }
            TEUpdate(box, gMATextBoxTE);
            END
        ELSE
            BEGIN
            { replace the existing QD procs ( standard or externally supplied )
            so that the (<potential>, see comment above) EraseRect in TEUpdate is ignored }

            IF thePort^.grafProcs <> NIL THEN
                BEGIN
                hadQDProcs := TRUE;
                saveRectProc := thePort^.grafProcs^.rectProc;
                thePort^.grafProcs^.rectProc := @StdNoRect;
                END
            ELSE
                BEGIN
                hadQDProcs := FALSE;
                IF IsColorPort(thePort) THEN
                    BEGIN
                    SetStdCProcs(myCQDProcs);
                    myCQDProcs.rectProc := @StdNoRect;
                    thePort^.grafProcs := @myCQDProcs;
                    END
                ELSE
                    BEGIN
                    SetStdProcs(myQDProcs);
                    myQDProcs.rectProc := @StdNoRect;
                    thePort^.grafProcs := @myQDProcs;
                    END;
                END;

            { Now do the imaging }
            TEUpdate(box, gMATextBoxTE);

            { Restore the QDProcs or eliminate the QDProcs, take yer pick. }
            IF hadQDProcs THEN
                thePort^.grafProcs^.rectProc := saveRectProc
            ELSE
                thePort^.grafProcs := NIL;

            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE MADrawString(s: StringPtr;
                       box: Rect;
                       justification: INTEGER);

    VAR
        theFontInfo:        FontInfo;
        widthOfString:        INTEGER;
        boxWidth:            INTEGER;

    BEGIN
    GetFontInfo(theFontInfo);
    widthOfString := StringWidth(s^);
    WITH box DO
        BEGIN
        boxWidth := right - left;
        IF widthOfString < boxWidth THEN
            BEGIN
            CASE GetActualJustification(justification) OF
                teJustLeft: ;
                teJustCenter:
                    left := left + (boxWidth - widthOfString) DIV 2;
                teJustRight:
                    left := left + boxWidth - widthOfString;
                teForceLeft: ;
            END;
            END;

        MoveTo(left, top + theFontInfo.ascent);
        DrawString(s^);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION PinOnRect(theRect: Rect;
                   thePt: Point): longint;

    BEGIN
    IF thePt.h < theRect.left THEN
        thePt.h := theRect.left;
    IF thePt.h > theRect.right THEN
        thePt.h := theRect.right;
    IF thePt.v < theRect.top THEN
        thePt.v := theRect.top;
    IF thePt.v > theRect.bottom THEN
        thePt.v := theRect.bottom;

    PinOnRect := longint(thePt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

FUNCTION ReadInteger(prompt: Str255): INTEGER;

    VAR
        i:                    INTEGER;

    BEGIN
    {$IFC qDebug}
    DebugForceOutput(forceOn, forceUnchanged);
    {$EndC}
    Write(prompt);
    Readln(i);
    {$IFC qDebug}
    DebugEndForce;
    {$EndC}
    ReadInteger := i;
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

FUNCTION ReadYesNo(prompt: Str255): Boolean;

    VAR
        s:                    Str255;

    BEGIN
    {$IFC qDebug}
    DebugForceOutput(forceOn, forceUnchanged);
    {$EndC}
    Write(prompt);
    Readln(s);
    {$IFC qDebug}
    DebugEndForce;
    {$EndC}
    ReadYesNo := (s <> '') & (s[1] IN ['y', 'Y']);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION RectsNest(outer, inner: Rect): Boolean;

    BEGIN
    WITH inner DO
        RectsNest := (left >= outer.left) & (right <= outer.right) & (top >= outer.top) & (bottom <=
                     outer.bottom);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION VRectsNest(outer, inner: VRect): Boolean;

    BEGIN
    WITH inner DO
        VRectsNest := (left >= outer.left) & (right <= outer.right) & (top >= outer.top) &
                      (bottom <= outer.bottom);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION RoundUp(aNumber: longint;
                 aModulus: INTEGER): longint;

    BEGIN
    RoundUp := ((aNumber + aModulus - 1) DIV aModulus) * aModulus;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE ScrapStuffFields(aTitle: Str255;
                           VAR aScrapStuff: ScrapStuff;
                           PROCEDURE DoToField(fieldName: Str255;
                                               fieldAddr: Ptr;
                                               fieldType: INTEGER));

    BEGIN
    DoToField(aTitle, NIL, bTitle);
    DoToField('  scrapSize', @aScrapStuff.scrapSize, bLongint);
    DoToField('  scrapHandle', @aScrapStuff.scrapHandle, bHandle);
    DoToField('  scrapCount', @aScrapStuff.scrapCount, bInteger);
    DoToField('  scrapState', @aScrapStuff.scrapState, bInteger);
    IF aScrapStuff.scrapName <> NIL THEN
        DoToField('  scrapName', @aScrapStuff.scrapName^, bString)
    ELSE
        DoToField('  scrapName', NIL, bPointer);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION SetKeyScript(newKeyScript: INTEGER): INTEGER;

    VAR
        currentKeyScript:    INTEGER;

    BEGIN
    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        BEGIN
        currentKeyScript := GetEnvirons(smKeyScript);
        IF currentKeyScript <> newKeyScript THEN
            KeyScript(newKeyScript);
        SetKeyScript := currentKeyScript;
        END
    ELSE
        BEGIN
        { ??? what it the correct thing to do if we get here? }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     {Must be in Main segment and cannot call to
                                                         any other segment.}

PROCEDURE SetHandleBits(h: Handle;
                        theBits: SignedByte);

    BEGIN
    IF qNeedsROM128K | gConfiguration.hasROM128K THEN
        HSetState(h, theBits)
    ELSE
        SignedBytePtr(h)^ := theBits;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC NOT qNeedsColorQD}                                { Becomes an inline if we know the machine
                                                         has color QD }
{$S MAUtilitiesRes}

PROCEDURE SetIfBkColor(aColor: RGBColor);

    CONST
        SignBit             = 15;

    VAR
        index:                INTEGER;
        oldColor:            longint;

    BEGIN
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        BEGIN
        { if not color port or color doesn't match then make trap }
        WITH CGrafPtr(thePort)^ DO
            IF (BAND(portVersion, $C000) <> $0000C000) | NOT EqualBlocks(@rgbBkColor, @aColor,
                                                                         sizeof(RGBColor)) THEN
                RGBBackColor(aColor);
        END
    ELSE
        BEGIN
        index := 0;                                     { Prime index }
        IF BTST(aColor.red, SignBit) THEN                { Set bit if red >= $8000 }
            index := 4;
        IF BTST(aColor.green, SignBit) THEN             { Set bit if green >= $8000 }
            index := index + 2;
        IF BTST(aColor.blue, SignBit) THEN                { Set bit if blue >= $8000 }
            index := index + 1;
        CASE index OF
            0:
                oldColor := blackColor;
            1:
                oldColor := blueColor;
            2:
                oldColor := greenColor;
            3:
                oldColor := cyanColor;
            4:
                oldColor := redColor;
            5:
                oldColor := magentaColor;
            6:
                oldColor := yellowColor;
            7:
                oldColor := whiteColor;
        END;
        BackColor(oldColor);
        END;
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$IFC NOT qNeedsColorQD}                                { Becomes an inline if we know the machine
                                                         has color QD }
{$S MAUtilitiesRes}

PROCEDURE SetIfColor(aColor: RGBColor);

    CONST
        SignBit             = 15;

    VAR
        index:                INTEGER;
        oldColor:            longint;

    BEGIN
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        BEGIN
        { if not color port or color doesn't match then make trap }
        WITH CGrafPtr(thePort)^ DO
            IF (BAND(portVersion, $C000) <> $0000C000) | NOT EqualBlocks(@rgbFgColor, @aColor,
                                                                         sizeof(RGBColor)) THEN
                RGBForeColor(aColor);
        END
    ELSE
        BEGIN
        index := 0;                                     { Prime index }
        IF BTST(aColor.red, SignBit) THEN                { Set bit if red >= $8000 }
            index := 4;
        IF BTST(aColor.green, SignBit) THEN             { Set bit if green >= $8000 }
            index := index + 2;
        IF BTST(aColor.blue, SignBit) THEN                { Set bit if blue >= $8000 }
            index := index + 1;
        CASE index OF
            0:
                oldColor := blackColor;
            1:
                oldColor := blueColor;
            2:
                oldColor := greenColor;
            3:
                oldColor := cyanColor;
            4:
                oldColor := redColor;
            5:
                oldColor := magentaColor;
            6:
                oldColor := yellowColor;
            7:
                oldColor := whiteColor;
        END;
        ForeColor(oldColor);
        END;
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE GetPortTextStyle(theTextStyle: TextStyle);

    BEGIN
    WITH thePort^, theTextStyle DO
        BEGIN
        tsFont := txFont;
        tsFace := txFace;
        tsSize := txSize;
        GetIfColor(tsColor);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE SetPortTextStyle(theTextStyle: TextStyle);

    BEGIN
    { Don't make the traps unless we need to }
    WITH thePort^, theTextStyle DO
        BEGIN
        IF txFont <> tsFont THEN
            TextFont(tsFont);
        IF txFace <> tsFace THEN
            TextFace(tsFace);
        IF txSize <> tsSize THEN
            TextSize(tsSize);
        SetIfColor(tsColor);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push}                                                 { Must be in Main segment, and generic code,
                                                         because InitToolBox calls this }
{$MC68020-}
{$S MAUtilitiesRes}

PROCEDURE SetRGBColor(VAR RGB: RGBColor;
                      red, green, blue: INTEGER);

    BEGIN
    RGB.red := red;
    RGB.green := green;
    RGB.blue := blue;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE SetTextStyle(VAR theTextStyle: TextStyle;
                       theFont: INTEGER;
                       theStyle: Style;
                       theSize: INTEGER;
                       theColor: RGBColor);

    BEGIN
    WITH theTextStyle DO
        BEGIN
        tsFont := theFont;
        tsFace := theStyle;
        tsSize := theSize;
        tsColor := theColor;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

PROCEDURE StdFieldToString(theData: Ptr;
                           fieldType: INTEGER;
                           VAR theString: Str255);

    CONST
        adnFrame            = [adnLineTop, adnLineLeft, adnLineBottom, adnLineRight];
        kDecPrec            = 4;                        { Change this if you want more decimal
                                                         precision in extended}

    TYPE
        TAlias                = RECORD
            CASE INTEGER OF
                bBoolean:
                    (asBoolean:          Boolean);
                bFontName, bCmdNumber, bHighByte, bLowByte, bHexInteger, bInteger:
                    (asInteger:          INTEGER);
                bFixed, bHexLongInt, bLongint:
                    (asLongInt:          longint);
                bString:
                    (asString:             Str255);
                bChar:
                    (asChar:             CHAR);
                bGrafPtr, bWindowPtr, bPointer:
                    (asPointer:          Ptr);
                bRgnHandle, bControlHandle, bTEHandle, bHandle:
                    (asHandle:             Handle);
                bPoint:
                    (asPoint:             Point);
                bRect:
                    (asRect:             Rect);
                bObject:
                    (asObject:             Handle);
                bByte:
                    (asByte:             SignedByte);
                bHLState:
                    (asHLState:          SignedByte);
                bIdType, bResType, bOSType:
                    (asOSType:             OSType);
                bPattern:
                    (asPattern:          Pattern);
                bRGBColor:
                    (asRGBColor:         RGBColor);
                bStyle:
                    (asStyle:             Style);
                bVCoordinate:
                    (asVCoordinate:      VCoordinate);
                bVPoint:
                    (asVPoint:             VPoint);
                bVRect:
                    (asVRect:             VRect);
                bStringHandle:
                    (asStrHandle:         StringHandle);
                bCntlAdornment:
                    (asCntlAdornment:     CntlAdornment);
                bSizeDeterminer:
                    (asSizeDeterminer:     SignedByte);
                bReal, bSingle:
                    (asReal:             Real);
                bDouble:
                    (asDouble:             Double);
                bExtended:
                    (asExtended:         Extended);
                bVHSelect:
                    (asVHSelect:         VHSelect);
            END;

    VAR
        alias:                ^TAlias;
        aString:            Str255;
        hexString:            String8;
        i:                    INTEGER;
        { Extended support }
        aDecForm:            DecForm;
        x:                    Extended;
        NumStr:             DecStr;

    PROCEDURE CheckStyleItem(s: StyleItem;
                             name: Str255);

        BEGIN
        IF s IN alias^.asStyle THEN
            IF theString = '[' THEN
                theString := CONCAT(theString, name)
            ELSE
                theString := CONCAT(theString, ',', name);
        END;

    PROCEDURE CheckAdornment(p: CntlAdornment;
                             name: Str255);

        BEGIN
        { "set1 <= set2" means set1 is wholly contained in set2 }
        IF p <= alias^.asCntlAdornment THEN
            IF theString = '[' THEN
                theString := CONCAT(theString, name)
            ELSE
                theString := CONCAT(theString, ',', name);
        END;

    BEGIN
    alias := Pointer(theData);
    theString := '';
    WITH alias^ DO
        CASE fieldType OF
            bBoolean:
                BEGIN
                NumberToHex(asByte, theString, 2);
                Insert(' (', theString, 1);
                theString := CONCAT(theString, ')');
                Insert(gBoolString[Ord(asBoolean) <> 0], theString, 1);
                END;
            bFontName:
                GetFontName(asInteger, theString);
            bInteger:
                NumToString(asInteger, theString);
            bLongint:
                NumToString(asLongInt, theString);
            bHexInteger:
                NumberToHex(asInteger, theString, 4);
            bHexLongInt:
                NumberToHex(asLongInt, theString, 8);
            bHighByte:
                NumberToHex(BSR(BAND(asInteger, $FF00), 8), theString, 2);
            bLowByte:
                NumberToHex(BAND(asInteger, $00FF), theString, 2);
            bFixed:
                BEGIN
                NumToString(HiWrd(asLongInt), aString);
                NumToString(LoWrd(asLongInt), theString);
                theString := CONCAT(aString, ':', theString);
                END;
            bString:
                theString := asString;
            bChar:
                BEGIN
                theString := ' ';
                theString[1] := asChar;
                END;
            bGrafPtr, bWindowPtr, bPointer:
                BEGIN
                PointerToHex(ORD4(asPointer), aString, 8);
                IF Odd(ORD4(asPointer)) THEN
                    theString := CONCAT('INVALID! (', aString, ')')
                ELSE IF asHandle = NIL THEN
                    theString := 'Nil'
                ELSE
                    theString := aString;
                END;
            bRgnHandle, bControlHandle, bTEHandle, bHandle:
                BEGIN
                PointerToHex(ORD4(asHandle), aString, 8);
                IF Odd(ORD4(asHandle)) THEN
                    theString := CONCAT('INVALID! (', aString, ')')
                ELSE IF asHandle = NIL THEN
                    theString := 'Nil'
                ELSE
                    theString := aString;
                END;
            bPoint:
                BEGIN
                NumToString(asPoint.h, aString);
                NumToString(asPoint.v, theString);
                theString := CONCAT('(h:', aString, ', v:', theString, ')');
                END;
            bRect:
                BEGIN
                NumToString(asRect.left, aString);
                NumToString(asRect.top, theString);
                theString := CONCAT('(l:', aString, ', t:', theString, ')/(r:');
                NumToString(asRect.right, aString);
                theString := CONCAT(theString, aString, ', b:');
                NumToString(asRect.bottom, aString);
                theString := CONCAT(theString, aString, ')');
                END;
            bObject:
                BEGIN
                PointerToHex(ORD4(asObject), aString, 8);
                IF Odd(ORD4(asObject)) THEN
                    theString := CONCAT('INVALID! (', aString, ')')
                ELSE IF asObject = NIL THEN
                    theString := 'Nil'
                ELSE
                    theString := aString;
                END;
            bByte:
                NumToString(asByte, theString);
            bHLState:
                CASE asHLState OF
                    1:
                        theString := 'hlOff';
                    2:
                        theString := 'hlDim';
                    4:
                        theString := 'hlOn';
                    OTHERWISE
                        BEGIN
                        NumToString(asHLState, aString);
                        theString := CONCAT('INVALID! (', aString, ')');
                        END;
                END;
            bCmdNumber:
                NumToString(asInteger, theString);
            bIdType, bResType, bOSType:
                BEGIN
                theString := '''    ''';
                FOR i := 1 TO 4 DO
                    theString[i + 1] := asOSType[i];
                END;
            bPattern:
                BEGIN
                theString := '$';
                FOR i := 0 TO 7 DO
                    BEGIN
                    LIntToHex(asPattern[i], hexString, 2);
                    theString := CONCAT(theString, hexString);
                    END;
                END;
            bRGBColor:
                WITH asRGBColor DO
                    IF (red = 0) & (green = 0) & (blue = 0) THEN
                        theString := 'Black'
                    ELSE IF (red = $FFFF) & (green = $FFFF) & (blue = $FFFF) THEN
                        theString := 'White'
                    ELSE
                        BEGIN
                        NumberToHex(asRGBColor.red, theString, 4);
                        NumberToHex(asRGBColor.green, aString, 4);
                        theString := CONCAT(theString, '/', aString);
                        NumberToHex(asRGBColor.blue, aString, 4);
                        theString := CONCAT(theString, '/', aString);
                        END;
            bStyle:
                BEGIN
                theString := '[';
                CheckStyleItem(bold, 'bold');
                CheckStyleItem(italic, 'italic');
                CheckStyleItem(underline, 'underline');
                CheckStyleItem(outline, 'outline');
                CheckStyleItem(shadow, 'shadow');
                CheckStyleItem(condense, 'condense');
                CheckStyleItem(extend, 'extend');
                theString := CONCAT(theString, ']');
                END;
            bVCoordinate:
                NumToString(asVCoordinate, theString);
            bVPoint:
                BEGIN
                NumToString(asVPoint.h, aString);
                NumToString(asVPoint.v, theString);
                theString := CONCAT('(h:', aString, ', v:', theString, ')');
                END;
            bVRect:
                BEGIN
                NumToString(asVRect.left, aString);
                NumToString(asVRect.top, theString);
                theString := CONCAT('(l:', aString, ', t:', theString, ')/(r:');
                NumToString(asVRect.right, aString);
                theString := CONCAT(theString, aString, ', b:');
                NumToString(asVRect.bottom, aString);
                theString := CONCAT(theString, aString, ')');
                END;
            bStringHandle:
                IF asStrHandle = NIL THEN
                    theString := 'Nil'
                ELSE
                    theString := asStrHandle^^;
            bCntlAdornment:
                BEGIN
                theString := '[';
                IF adnFrame <= asCntlAdornment THEN
                    CheckAdornment(adnFrame, 'frame')
                ELSE
                    BEGIN
                    CheckAdornment([adnLineTop], 'top');
                    CheckAdornment([adnLineLeft], 'left');
                    CheckAdornment([adnLineBottom], 'bottom');
                    CheckAdornment([adnLineRight], 'right');
                    END;
                { CheckAdornment(adnPatFill, 'fill'); }
                CheckAdornment([adnOval], 'oval');
                CheckAdornment([adnRRect], 'rrect');
                CheckAdornment([adnShadow], 'shadow');
                theString := CONCAT(theString, ']');
                END;
            bSizeDeterminer:
                CASE asSizeDeterminer OF
                    0:
                        theString := 'sizeSuperView';
                    1:
                        theString := 'sizeRelSuperView';
                    2:
                        theString := 'sizePage';
                    3:
                        theString := 'sizeFillPages';
                    4:
                        theString := 'sizeVariable';
                    5:
                        theString := 'sizeFixed';
                END;
            bReal, bSingle:
                BEGIN
                aDecForm.Style := FixedDecimal;
                aDecForm.digits := kDecPrec;
                x := asReal;
                Num2Str(aDecForm, x, NumStr);
                theString := Str255(NumStr);
                END;
            bDouble:
                BEGIN
                aDecForm.Style := FixedDecimal;
                aDecForm.digits := kDecPrec;
                x := asDouble;
                Num2Str(aDecForm, x, NumStr);
                theString := Str255(NumStr);
                END;
            bExtended:
                BEGIN
                aDecForm.Style := FixedDecimal;
                aDecForm.digits := kDecPrec;
                x := asExtended;
                Num2Str(aDecForm, x, NumStr);
                theString := Str255(NumStr);
                END;
            bVHSelect:
                BEGIN
                CASE asVHSelect OF
                    v:
                        theString := 'v';
                    h:
                        theString := 'h';
                    OTHERWISE
                        BEGIN
                        NumToString(ORD(asVHSelect), aString);
                        theString := CONCAT('INVALID! (', aString, ')');
                        END;
                END;
                END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}

FUNCTION StripLong(address: UNIV Ptr): longint;
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TextStyleFields(aTitle: Str255;
                          VAR aStyle: TextStyle;
                          PROCEDURE DoToField(fieldName: Str255;
                                              fieldAddr: Ptr;
                                              fieldType: INTEGER));

    BEGIN
    DoToField(aTitle, NIL, bTitle);
    DoToField('  Font', @aStyle.tsFont, bFontName);
    DoToField('  Face', @aStyle.tsFace, bStyle);
    DoToField('  Size', @aStyle.tsSize, bInteger);
    DoToField('  Color', @aStyle.tsColor, bRGBColor);
    END;

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}
{$S MAUtilitiesRes}

FUNCTION NumToolboxTraps: INTEGER;
{ InitGraf is always implemented (trap $A86E). If the trap table is big enough, trap $AA6E
will always point to either Unimplemented or some other trap, but will never be the same
as InitGraf. Thus, you can check the size of the trap table by asking if the address of
trap $A86E is the same as $AA6E. }

    BEGIN
    IF NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) THEN
        NumToolboxTraps := $200
    ELSE
        NumToolboxTraps := $400;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
{$MC68020-}
{$S MAUtilitiesRes}

FUNCTION TrapExists(theTrap: INTEGER): Boolean;

    VAR
        theTrapType:        TrapType;

    BEGIN
    theTrapType := GetTrapType(theTrap);
    IF (theTrapType = ToolTrap) THEN
        BEGIN
        theTrap := BAND(theTrap, $07FF);
        IF theTrap >= NumToolboxTraps THEN
            theTrap := _Unimplemented;
        END;

    TrapExists := NGetTrapAddress(_Unimplemented, ToolTrap) <> NGetTrapAddress(theTrap,
                  theTrapType);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

FUNCTION UprChar(ch: CHAR): CHAR;

    BEGIN
    IF (ch IN ['a'..'z']) THEN
        UprChar := CHR(Ord(ch) - 32)
    ELSE
        UprChar := ch;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE UprStr255(VAR s: Str255);

    VAR
        i:                    INTEGER;

    BEGIN
    FOR i := 1 TO LENGTH(s) DO
        IF (s[i] IN ['a'..'z']) THEN
            s[i] := CHR(Ord(s[i]) - 32)
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE UprMAName(VAR s: MAName);

    VAR
        i:                    INTEGER;

    BEGIN
    FOR i := 1 TO LENGTH(s) DO
        IF (s[i] IN ['a'..'z']) THEN
            s[i] := CHR(Ord(s[i]) - 32)
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE UseROMMap(resLoad: Boolean);

    BEGIN
    IF qNeedsROM128K | gConfiguration.hasROM128K THEN
        BEGIN
        IF resLoad THEN
            GetROMMapInsert^ := kLMmapTrue
        ELSE
            GetROMMapInsert^ := kLMmapFalse;
        END
    ELSE
        SetResLoad(resLoad);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

FUNCTION VerboseIsHandle(h: UNIV Handle): Boolean;

    CONST
        kUnInitStorage1     = $72677267;                { Pascal provided uninited storage }
        kUnInitStorage2     = $67726772;                { odd byte boundary of above }
        kDebugHandleInit    = $F3F3F3F3;                { Handles are inited to this in MacApp® }
        kDebugPtrInit        = $F5F5F5F5;                { Pointers are inited to this in MacApp® }
        kDebugObjInit        = $F1F1F1F1;                { Objects are inited to this in MacApp® }

    VAR
        masterPointer:        Ptr;

    BEGIN
    VerboseIsHandle := FALSE;

    IF Odd(Ord(h)) THEN
        BEGIN
        IF Ord(h) = kUnInitStorage1 THEN
            WriteLn('  That handle appears to be from uninitialized storage.')
        ELSE IF (Ord(h) = kDebugHandleInit) THEN
            WriteLn('  That handle appears to be from a handle initialized by debugging.')
        ELSE IF (Ord(h) = kDebugPtrInit) THEN
            WriteLn('  That handle appears to be from a pointer initialized by debugging.')
        ELSE IF (Ord(h) = kDebugObjInit) THEN
            WriteLn('  That handle appears to be an uninitialized instance variable.')
        ELSE
            WriteLn('  That handle is odd.');
        END
    ELSE IF Ord(h) = kUnInitStorage2 THEN
        WriteLn('  That handle appears to be from uninitialized storage.')
    ELSE IF h = NIL THEN
        WriteLn('  That handle is NIL.')
    ELSE
        BEGIN
        masterPointer := Ptr(StripLong(h^));
        IF Odd(Ord(masterPointer)) THEN
            WriteLn('  The master pointer is odd.')
        ELSE IF IsFreeHandle(h) THEN
            WriteLn('  The handle has been freed.')
        ELSE IF ((masterPointer <> NIL) & NOT TestRecoverHandle(masterPointer, h)) THEN
            WriteLn('  The alleged heap header is invalid.')
        ELSE
            VerboseIsHandle := TRUE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}

PROCEDURE WithApplicationResFileDo(PROCEDURE DoWithResFile);
{??? Needs a failure handler ???}

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := CurResFile;
    UseResFile(gApplicationRefNum);
    DoWithResFile;
    UseResFile(oldResFile);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteHandleContents(theHandle: UNIV Handle);

    VAR
        Max, index:         Size;
        wasLocked:            Boolean;

    BEGIN
    Max := GetHandleSize(theHandle) - 1;
    IF Max > 0 THEN
        BEGIN
        wasLocked := IsHandleLocked(theHandle);
        IF NOT wasLocked THEN
            HLock(theHandle);
        FOR index := 0 TO Max DO
            Write(CHR(Ptr(Ord(theHandle^) + index)^));
        IF NOT wasLocked THEN
            HUnLock(theHandle);
        END
    ELSE
        Write('**Empty**');
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblHandleContents(aLabel: Str255;
                              theHandle: UNIV Handle);

    BEGIN
    Write(aLabel, ' = '); WriteHandleContents(theHandle);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WritePt(pt: Point);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@pt, bPoint, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblPt(aLabel: Str255;
                  pt: Point);

    BEGIN
    Write(aLabel, ' = '); WritePt(pt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WritePtr(val: UNIV longint);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@val, bPointer, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblPtr(aLabel: Str255;
                   val: UNIV longint);

    BEGIN
    Write(aLabel, ' = '); WritePtr(val);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteRect(r: Rect);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@r, bRect, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblRect(aLabel: Str255;
                    r: Rect);

    BEGIN
    Write(aLabel, ' = '); WriteRect(r);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteBoolean(b: Boolean);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@b, bBoolean, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblBoolean(aLabel: Str255;
                       b: Boolean);

    BEGIN
    Write(aLabel, ' = ');
    WriteBoolean(b);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteVPt(pt: VPoint);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@pt, bVPoint, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblVPt(aLabel: Str255;
                   pt: VPoint);

    BEGIN
    Write(aLabel, ' = '); WriteVPt(pt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteVRect(r: VRect);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@r, bVRect, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblVRect(aLabel: Str255;
                     r: VRect);

    BEGIN
    Write(aLabel, ' = '); WriteVRect(r);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteSig(theID: IDType);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@theID, bIdType, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblSig(theLabel: Str255;
                   theID: IDType);

    BEGIN
    Write(theLabel, ' = '); WriteSig(theID);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteHexInt(theInt: INTEGER);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@theInt, bHexInteger, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblHexInt(theLabel: Str255;
                      theInt: INTEGER);

    BEGIN
    Write(theLabel, ' = '); WriteHexInt(theInt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WriteHexLongint(theLongint: longint);

    VAR
        theString:            Str255;

    BEGIN
    FieldToString(@theLongint, bHexLongInt, theString);
    Write(theString);
    END;

{--------------------------------------------------------------------------------------------------}
{$S WWSeg}

PROCEDURE WrLblHexLongint(theLabel: Str255;
                          theLongint: longint);

    BEGIN
    Write(theLabel, ' = '); WriteHexLongint(theLongint);
    END;